I’ve hidden all the code in this markdown by default, to make it easier to get to the map…

Continuing my explortion of Notification of Infectious Disease data, I’ve been working on an interactive map of where disease have been reported in England and Wales. I found this link a useful resource https://journocode.com/2016/01/28/your-first-choropleth-map/.

I was able to download data from the Notification of Infectious Disease website on the distrubtion of cases by local authority (“Statutory notifiable diseases - number of cases reported in week 51 of 2017”). I’ve limited this experimental analysis to one week of data. I did some refomatting in Excel and saved this as a .csv for speed and convinience, before loading it into R. I then explicitly set NA data to 0 (assuming no notifications means no cases). I also removed the string " UA" from where it appeared in local authority names.

library("reshape2")
library("magrittr")
geo_disease_data<-read.csv("geo_disease_data.csv")
geo_disease_data[is.na(geo_disease_data)] <- 0
geo_disease_data$LocalAuthority<-gsub(" UA", "", geo_disease_data$LocalAuthority)

The next task was to get some map data for local authorities. I played around with a few different maps from the Office for National Statistics Open Geography Portal (I’m new to geo-spatial data). This one seemed to be the best:

library("rgdal")

LocalAuthorities<-readOGR("https://opendata.arcgis.com/datasets/686603e943f948acaa13fb5d2b0f1275_4.geojson")

I then merged the two data sets by local authority name.

LA_Diseases<-sp::merge(LocalAuthorities, geo_disease_data, by.x="lad16nm", by.y="LocalAuthority")

The next task was to display the data as a map. For this I used leaflet. This is a wrapper for a Javascrip “App”. I’ve put some comments in the code to explain what’s going on at each step.

library("leaflet")
diseases <- names(geo_disease_data)[-1] #Get a list of disease names (the first colmn name here is local authority name)
max_cases <- max(melt(geo_disease_data, id.vars="LocalAuthority")$value) #Get the maximum number of cases for any disease
#Set up a colour scale from 0 to the maximum number of diseases
pal <- colorNumeric(
   palette = "viridis",
   domain = c(0,max_cases)
 )
#Initialise the map with the legend and a control to allow users to select a disease
myleaflet<-leaflet(width = "100%") %>% 
  addProviderTiles("Esri.WorldGrayCanvas") %>%
  addLegend( pal = pal, 
             values = 0:max_cases,
             title = "Cases",
             opacity = 1) %>%
  addLayersControl(baseGroups=diseases, 
                   position = "bottomleft", 
                   options = layersControlOptions(collapsed = TRUE))
#Add a layer to the map for each disease
for (active_disease in diseases) 
  {
  myleaflet <- myleaflet %>%
    addPolygons(data=LA_Diseases, 
              fillColor=~pal(LA_Diseases[[active_disease]]),
              fillOpacity = 0.8,
              color = "black",
              weight = 1,
              popup = paste(LA_Diseases$lad16nm, LA_Diseases[[active_disease]],"cases"), #This popup shows the local authority name and number of cases
              group = active_disease
              )
  }    
myleaflet #show the map

I have a few problems! The main issue is that I don’t have data for all of the local authorities. I thought I would try to find out why so I got a list of local authorities from the disease data and another list from the map.

Unique_LA_Map<-data.frame(LocalAuthority=unique(LocalAuthorities$lad16nm) %>% sort())
Unique_LA_Diseases<-data.frame(LocalAuthority=unique(geo_disease_data$LocalAuthority) %>% sort())

Next, I did some joins to see how many of the names were shared between the data sets and how many were unique to each.

In_Map_Not_Diseases<-data.frame(LocalAuthority=
  Unique_LA_Map$LocalAuthority[!(Unique_LA_Map$LocalAuthority %in% Unique_LA_Diseases$LocalAuthority)])
In_Diseases_Not_Map<-data.frame(LocalAuthority=
  Unique_LA_Diseases$LocalAuthority[!(Unique_LA_Diseases$LocalAuthority %in% Unique_LA_Map$LocalAuthority)])
In_Both<-base::merge(Unique_LA_Map,Unique_LA_Diseases, by="LocalAuthority")

I’ve plotted the results on a Venn diagram. Not the most beautiful, but quite informative.

library(VennDiagram)
grid.newpage()
draw.pairwise.venn(area1 = nrow(Unique_LA_Diseases), 
                   area2 = nrow(Unique_LA_Map), 
                   cross.area = nrow(In_Both), 
                   category = c("n in Diseases Data", "n in Map Data"),
                   fill = c("blue", "red")
                   )
(polygon[GRID.polygon.151], polygon[GRID.polygon.152], polygon[GRID.polygon.153], polygon[GRID.polygon.154], text[GRID.text.155], text[GRID.text.156], lines[GRID.lines.157], text[GRID.text.158], text[GRID.text.159], text[GRID.text.160]) 

276 local authorities are in both data sets, 104 are only in the map data and 12 are unique to the disease data. A large part of the explaination of this is that the map includes scottish local authorities, but the disease data is only for England and Wales. Looking at the data frames, there are some instances where the name is stated differently in each set - despite referring to the same authority e.g. “City of Kingston upon Hull” and “Kingston upon Hull, City of”. And there are some like “East Dorset” that are on the map but don’t seem to have a match at all.

My conclusion is that, whilst making maps of infectious disease occurances is a great way of getting insights out of the data, I would need to access some domain knowledge on mapping local authorities to take this much further.

LS0tDQp0aXRsZTogIk1hcCBvZiBJbmZlY3Rpb3VzIERpc2Vhc2UgTm90aWZpY2F0aW9ucyINCm91dHB1dDogDQogIGh0bWxfbm90ZWJvb2s6DQogICAgY29kZV9mb2xkaW5nOiBoaWRlDQotLS0NCg0KKkkndmUgaGlkZGVuIGFsbCB0aGUgY29kZSBpbiB0aGlzIG1hcmtkb3duIGJ5IGRlZmF1bHQsIHRvIG1ha2UgaXQgZWFzaWVyIHRvIGdldCB0byB0aGUgbWFwLi4uKg0KDQpDb250aW51aW5nIG15IGV4cGxvcnRpb24gb2YgW05vdGlmaWNhdGlvbiBvZiBJbmZlY3Rpb3VzIERpc2Vhc2VdKGh0dHBzOi8vd3d3Lmdvdi51ay9nb3Zlcm5tZW50L2NvbGxlY3Rpb25zL25vdGlmaWNhdGlvbnMtb2YtaW5mZWN0aW91cy1kaXNlYXNlcy1ub2lkcykgZGF0YSwgSSd2ZSBiZWVuIHdvcmtpbmcgb24gYW4gaW50ZXJhY3RpdmUgbWFwIG9mIHdoZXJlIGRpc2Vhc2UgaGF2ZSBiZWVuIHJlcG9ydGVkIGluIEVuZ2xhbmQgYW5kIFdhbGVzLiBJIGZvdW5kIHRoaXMgbGluayBhIHVzZWZ1bCByZXNvdXJjZSBodHRwczovL2pvdXJub2NvZGUuY29tLzIwMTYvMDEvMjgveW91ci1maXJzdC1jaG9yb3BsZXRoLW1hcC8uDQoNCkkgd2FzIGFibGUgdG8gZG93bmxvYWQgZGF0YSBmcm9tIHRoZSBbTm90aWZpY2F0aW9uIG9mIEluZmVjdGlvdXMgRGlzZWFzZV0oaHR0cHM6Ly93d3cuZ292LnVrL2dvdmVybm1lbnQvY29sbGVjdGlvbnMvbm90aWZpY2F0aW9ucy1vZi1pbmZlY3Rpb3VzLWRpc2Vhc2VzLW5vaWRzKSB3ZWJzaXRlIG9uIHRoZSBkaXN0cnVidGlvbiBvZiBjYXNlcyBieSBsb2NhbCBhdXRob3JpdHkgKCJTdGF0dXRvcnkgbm90aWZpYWJsZSBkaXNlYXNlcyAgLSBudW1iZXIgb2YgY2FzZXMgcmVwb3J0ZWQgaW4gd2VlayA1MSBvZiAyMDE3IikuIEkndmUgbGltaXRlZCB0aGlzIGV4cGVyaW1lbnRhbCBhbmFseXNpcyB0byBvbmUgd2VlayBvZiBkYXRhLiBJIGRpZCBzb21lIHJlZm9tYXR0aW5nIGluIEV4Y2VsIGFuZCBzYXZlZCB0aGlzIGFzIGEgLmNzdiBmb3Igc3BlZWQgYW5kIGNvbnZpbmllbmNlLCBiZWZvcmUgbG9hZGluZyBpdCBpbnRvIFIuIEkgdGhlbiBleHBsaWNpdGx5IHNldCBOQSBkYXRhIHRvIDAgKGFzc3VtaW5nIG5vIG5vdGlmaWNhdGlvbnMgbWVhbnMgbm8gY2FzZXMpLiBJIGFsc28gcmVtb3ZlZCB0aGUgc3RyaW5nICIgVUEiIGZyb20gd2hlcmUgaXQgYXBwZWFyZWQgaW4gbG9jYWwgYXV0aG9yaXR5IG5hbWVzLgkJCQkNCg0KYGBge3J9DQoNCmxpYnJhcnkoInJlc2hhcGUyIikNCmxpYnJhcnkoIm1hZ3JpdHRyIikNCg0KZ2VvX2Rpc2Vhc2VfZGF0YTwtcmVhZC5jc3YoImdlb19kaXNlYXNlX2RhdGEuY3N2IikNCg0KZ2VvX2Rpc2Vhc2VfZGF0YVtpcy5uYShnZW9fZGlzZWFzZV9kYXRhKV0gPC0gMA0KDQpnZW9fZGlzZWFzZV9kYXRhJExvY2FsQXV0aG9yaXR5PC1nc3ViKCIgVUEiLCAiIiwgZ2VvX2Rpc2Vhc2VfZGF0YSRMb2NhbEF1dGhvcml0eSkNCmBgYA0KDQpUaGUgbmV4dCB0YXNrIHdhcyB0byBnZXQgc29tZSBtYXAgZGF0YSBmb3IgbG9jYWwgYXV0aG9yaXRpZXMuIEkgcGxheWVkIGFyb3VuZCB3aXRoIGEgZmV3IGRpZmZlcmVudCBtYXBzIGZyb20gW3RoZSBPZmZpY2UgZm9yIE5hdGlvbmFsIFN0YXRpc3RpY3MgT3BlbiBHZW9ncmFwaHkgUG9ydGFsXShodHRwOi8vZ2VvcG9ydGFsLnN0YXRpc3RpY3MuZ292LnVrL2RhdGFzZXRzLykgKEknbSBuZXcgdG8gZ2VvLXNwYXRpYWwgZGF0YSkuIFRoaXMgb25lIHNlZW1lZCB0byBiZSB0aGUgYmVzdDoNCg0KYGBge3IsIGV2YWw9RkFMU0V9DQoNCmxpYnJhcnkoInJnZGFsIikNCg0KTG9jYWxBdXRob3JpdGllczwtcmVhZE9HUigiaHR0cHM6Ly9vcGVuZGF0YS5hcmNnaXMuY29tL2RhdGFzZXRzLzY4NjYwM2U5NDNmOTQ4YWNhYTEzZmI1ZDJiMGYxMjc1XzQuZ2VvanNvbiIpDQoNCmBgYA0KDQpJIHRoZW4gbWVyZ2VkIHRoZSB0d28gZGF0YSBzZXRzIGJ5IGxvY2FsIGF1dGhvcml0eSBuYW1lLg0KDQpgYGB7cn0NCg0KTEFfRGlzZWFzZXM8LXNwOjptZXJnZShMb2NhbEF1dGhvcml0aWVzLCBnZW9fZGlzZWFzZV9kYXRhLCBieS54PSJsYWQxNm5tIiwgYnkueT0iTG9jYWxBdXRob3JpdHkiKQ0KDQpgYGANCg0KVGhlIG5leHQgdGFzayB3YXMgdG8gZGlzcGxheSB0aGUgZGF0YSBhcyBhIG1hcC4gRm9yIHRoaXMgSSB1c2VkIFtsZWFmbGV0XShodHRwOi8vbGVhZmxldGpzLmNvbS8pLiBUaGlzIGlzIGEgd3JhcHBlciBmb3IgYSBKYXZhc2NyaXAgIkFwcCIuIEkndmUgcHV0IHNvbWUgY29tbWVudHMgaW4gdGhlIGNvZGUgdG8gZXhwbGFpbiB3aGF0J3MgZ29pbmcgb24gYXQgZWFjaCBzdGVwLg0KDQpgYGB7cn0NCg0KbGlicmFyeSgibGVhZmxldCIpDQoNCmRpc2Vhc2VzIDwtIG5hbWVzKGdlb19kaXNlYXNlX2RhdGEpWy0xXSAjR2V0IGEgbGlzdCBvZiBkaXNlYXNlIG5hbWVzICh0aGUgZmlyc3QgY29sbW4gbmFtZSBoZXJlIGlzIGxvY2FsIGF1dGhvcml0eSBuYW1lKQ0KDQptYXhfY2FzZXMgPC0gbWF4KG1lbHQoZ2VvX2Rpc2Vhc2VfZGF0YSwgaWQudmFycz0iTG9jYWxBdXRob3JpdHkiKSR2YWx1ZSkgI0dldCB0aGUgbWF4aW11bSBudW1iZXIgb2YgY2FzZXMgZm9yIGFueSBkaXNlYXNlDQoNCiNTZXQgdXAgYSBjb2xvdXIgc2NhbGUgZnJvbSAwIHRvIHRoZSBtYXhpbXVtIG51bWJlciBvZiBkaXNlYXNlcw0KcGFsIDwtIGNvbG9yTnVtZXJpYygNCiAgIHBhbGV0dGUgPSAidmlyaWRpcyIsDQogICBkb21haW4gPSBjKDAsbWF4X2Nhc2VzKQ0KICkNCg0KI0luaXRpYWxpc2UgdGhlIG1hcCB3aXRoIHRoZSBsZWdlbmQgYW5kIGEgY29udHJvbCB0byBhbGxvdyB1c2VycyB0byBzZWxlY3QgYSBkaXNlYXNlDQpteWxlYWZsZXQ8LWxlYWZsZXQod2lkdGggPSAiMTAwJSIpICU+JSANCiAgYWRkUHJvdmlkZXJUaWxlcygiRXNyaS5Xb3JsZEdyYXlDYW52YXMiKSAlPiUNCiAgYWRkTGVnZW5kKCBwYWwgPSBwYWwsIA0KICAgICAgICAgICAgIHZhbHVlcyA9IDA6bWF4X2Nhc2VzLA0KICAgICAgICAgICAgIHRpdGxlID0gIkNhc2VzIiwNCiAgICAgICAgICAgICBvcGFjaXR5ID0gMSkgJT4lDQogIGFkZExheWVyc0NvbnRyb2woYmFzZUdyb3Vwcz1kaXNlYXNlcywgDQogICAgICAgICAgICAgICAgICAgcG9zaXRpb24gPSAiYm90dG9tbGVmdCIsIA0KICAgICAgICAgICAgICAgICAgIG9wdGlvbnMgPSBsYXllcnNDb250cm9sT3B0aW9ucyhjb2xsYXBzZWQgPSBUUlVFKSkNCg0KI0FkZCBhIGxheWVyIHRvIHRoZSBtYXAgZm9yIGVhY2ggZGlzZWFzZQ0KZm9yIChhY3RpdmVfZGlzZWFzZSBpbiBkaXNlYXNlcykgDQogIHsNCiAgbXlsZWFmbGV0IDwtIG15bGVhZmxldCAlPiUNCiAgICBhZGRQb2x5Z29ucyhkYXRhPUxBX0Rpc2Vhc2VzLCANCiAgICAgICAgICAgICAgZmlsbENvbG9yPX5wYWwoTEFfRGlzZWFzZXNbW2FjdGl2ZV9kaXNlYXNlXV0pLA0KICAgICAgICAgICAgICBmaWxsT3BhY2l0eSA9IDAuOCwNCiAgICAgICAgICAgICAgY29sb3IgPSAiYmxhY2siLA0KICAgICAgICAgICAgICB3ZWlnaHQgPSAxLA0KICAgICAgICAgICAgICBwb3B1cCA9IHBhc3RlKExBX0Rpc2Vhc2VzJGxhZDE2bm0sIExBX0Rpc2Vhc2VzW1thY3RpdmVfZGlzZWFzZV1dLCJjYXNlcyIpLCAjVGhpcyBwb3B1cCBzaG93cyB0aGUgbG9jYWwgYXV0aG9yaXR5IG5hbWUgYW5kIG51bWJlciBvZiBjYXNlcw0KICAgICAgICAgICAgICBncm91cCA9IGFjdGl2ZV9kaXNlYXNlDQogICAgICAgICAgICAgICkNCiAgfSAgICANCg0KDQpteWxlYWZsZXQgI3Nob3cgdGhlIG1hcA0KDQpgYGANCg0KSSBoYXZlIGEgZmV3IHByb2JsZW1zISBUaGUgbWFpbiBpc3N1ZSBpcyB0aGF0IEkgZG9uJ3QgaGF2ZSBkYXRhIGZvciBhbGwgb2YgdGhlIGxvY2FsIGF1dGhvcml0aWVzLiBJIHRob3VnaHQgSSB3b3VsZCB0cnkgdG8gZmluZCBvdXQgd2h5IHNvIEkgZ290IGEgbGlzdCBvZiBsb2NhbCBhdXRob3JpdGllcyBmcm9tIHRoZSBkaXNlYXNlIGRhdGEgYW5kIGFub3RoZXIgbGlzdCBmcm9tIHRoZSBtYXAuDQoNCmBgYHtyfQ0KVW5pcXVlX0xBX01hcDwtZGF0YS5mcmFtZShMb2NhbEF1dGhvcml0eT11bmlxdWUoTG9jYWxBdXRob3JpdGllcyRsYWQxNm5tKSAlPiUgc29ydCgpKQ0KVW5pcXVlX0xBX0Rpc2Vhc2VzPC1kYXRhLmZyYW1lKExvY2FsQXV0aG9yaXR5PXVuaXF1ZShnZW9fZGlzZWFzZV9kYXRhJExvY2FsQXV0aG9yaXR5KSAlPiUgc29ydCgpKQ0KYGBgDQoNCk5leHQsIEkgZGlkIHNvbWUgam9pbnMgdG8gc2VlIGhvdyBtYW55IG9mIHRoZSBuYW1lcyB3ZXJlIHNoYXJlZCBiZXR3ZWVuIHRoZSBkYXRhIHNldHMgYW5kIGhvdyBtYW55IHdlcmUgdW5pcXVlIHRvIGVhY2guDQoNCmBgYHtyfQ0KDQpJbl9NYXBfTm90X0Rpc2Vhc2VzPC1kYXRhLmZyYW1lKExvY2FsQXV0aG9yaXR5PQ0KICBVbmlxdWVfTEFfTWFwJExvY2FsQXV0aG9yaXR5WyEoVW5pcXVlX0xBX01hcCRMb2NhbEF1dGhvcml0eSAlaW4lIFVuaXF1ZV9MQV9EaXNlYXNlcyRMb2NhbEF1dGhvcml0eSldKQ0KDQpJbl9EaXNlYXNlc19Ob3RfTWFwPC1kYXRhLmZyYW1lKExvY2FsQXV0aG9yaXR5PQ0KICBVbmlxdWVfTEFfRGlzZWFzZXMkTG9jYWxBdXRob3JpdHlbIShVbmlxdWVfTEFfRGlzZWFzZXMkTG9jYWxBdXRob3JpdHkgJWluJSBVbmlxdWVfTEFfTWFwJExvY2FsQXV0aG9yaXR5KV0pDQoNCkluX0JvdGg8LWJhc2U6Om1lcmdlKFVuaXF1ZV9MQV9NYXAsVW5pcXVlX0xBX0Rpc2Vhc2VzLCBieT0iTG9jYWxBdXRob3JpdHkiKQ0KYGBgDQoNCkkndmUgcGxvdHRlZCB0aGUgcmVzdWx0cyBvbiBhICoqVmVubiBkaWFncmFtKiouIE5vdCB0aGUgbW9zdCBiZWF1dGlmdWwsIGJ1dCBxdWl0ZSBpbmZvcm1hdGl2ZS4NCg0KYGBge3J9DQoNCmxpYnJhcnkoVmVubkRpYWdyYW0pDQpncmlkLm5ld3BhZ2UoKQ0KZHJhdy5wYWlyd2lzZS52ZW5uKGFyZWExID0gbnJvdyhVbmlxdWVfTEFfRGlzZWFzZXMpLCANCiAgICAgICAgICAgICAgICAgICBhcmVhMiA9IG5yb3coVW5pcXVlX0xBX01hcCksIA0KICAgICAgICAgICAgICAgICAgIGNyb3NzLmFyZWEgPSBucm93KEluX0JvdGgpLCANCiAgICAgICAgICAgICAgICAgICBjYXRlZ29yeSA9IGMoIm4gaW4gRGlzZWFzZXMgRGF0YSIsICJuIGluIE1hcCBEYXRhIiksDQogICAgICAgICAgICAgICAgICAgZmlsbCA9IGMoImJsdWUiLCAicmVkIikNCiAgICAgICAgICAgICAgICAgICApDQoNCmBgYA0KDQoyNzYgbG9jYWwgYXV0aG9yaXRpZXMgYXJlIGluIGJvdGggZGF0YSBzZXRzLCAxMDQgYXJlIG9ubHkgaW4gdGhlIG1hcCBkYXRhIGFuZCAxMiBhcmUgdW5pcXVlIHRvIHRoZSBkaXNlYXNlIGRhdGEuIEEgbGFyZ2UgcGFydCBvZiB0aGUgZXhwbGFpbmF0aW9uIG9mIHRoaXMgaXMgdGhhdCB0aGUgbWFwIGluY2x1ZGVzIHNjb3R0aXNoIGxvY2FsIGF1dGhvcml0aWVzLCBidXQgdGhlIGRpc2Vhc2UgZGF0YSBpcyBvbmx5IGZvciBFbmdsYW5kIGFuZCBXYWxlcy4gTG9va2luZyBhdCB0aGUgZGF0YSBmcmFtZXMsIHRoZXJlIGFyZSBzb21lIGluc3RhbmNlcyB3aGVyZSB0aGUgbmFtZSBpcyBzdGF0ZWQgZGlmZmVyZW50bHkgaW4gZWFjaCBzZXQgLSBkZXNwaXRlIHJlZmVycmluZyB0byB0aGUgc2FtZSBhdXRob3JpdHkgZS5nLiAiYHIgSW5fRGlzZWFzZXNfTm90X01hcCRMb2NhbEF1dGhvcml0eVtbM11dYCIgYW5kICJgciBJbl9NYXBfTm90X0Rpc2Vhc2VzJExvY2FsQXV0aG9yaXR5W1s0Nl1dYCIuIEFuZCB0aGVyZSBhcmUgc29tZSBsaWtlICJgciBJbl9NYXBfTm90X0Rpc2Vhc2VzJExvY2FsQXV0aG9yaXR5W1syNV1dYCIgdGhhdCBhcmUgb24gdGhlIG1hcCBidXQgZG9uJ3Qgc2VlbSB0byBoYXZlIGEgbWF0Y2ggYXQgYWxsLg0KDQpNeSBjb25jbHVzaW9uIGlzIHRoYXQsIHdoaWxzdCBtYWtpbmcgbWFwcyBvZiBpbmZlY3Rpb3VzIGRpc2Vhc2Ugb2NjdXJhbmNlcyBpcyBhIGdyZWF0IHdheSBvZiBnZXR0aW5nIGluc2lnaHRzIG91dCBvZiB0aGUgZGF0YSwgSSB3b3VsZCBuZWVkIHRvIGFjY2VzcyBzb21lIGRvbWFpbiBrbm93bGVkZ2Ugb24gbWFwcGluZyBsb2NhbCBhdXRob3JpdGllcyB0byB0YWtlIHRoaXMgbXVjaCBmdXJ0aGVyLg==